home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-19 / quikcmd3.zip / FASTLAYR.LSP < prev    next >
Lisp/Scheme  |  1992-07-05  |  8KB  |  225 lines
  1. ;  FASTLAYR.LSP
  2.  ;
  3.  ;                         QUICK COMMAND Release 3.0
  4.  ;                   FASTLAYR.LSP is a module of QUICK COMMAND
  5. ;                       Copyright 1989, 90, 92 Dan Jincks
  6.  ;
  7.  ;
  8. ;              This is SHAREWARE, it is NOT Public Domain software.
  9.  ;
  10.  ;              This code or any part of this code may not be reproduced
  11.  ;              in any publication without prior written permission.
  12.  ;
  13.  ;              Printed copy of this code or any part of this code may not
  14.  ;              be distributed without prior written permission.
  15.  ;
  16.  ;              Printed copy may only be made for reference purposes by
  17.  ;              the end user.
  18.  ;
  19.  ;
  20.  ;                               Dan Jincks
  21.  ;                             Box 155A HCR 77
  22.  ;                           Annapolis, MO 63620
  23.  ;
  24.  ;
  25.  ;
  26.  ;   You are granted a limited license to use FASTLAYR.LSP for a 30 day trial
  27.  ;   period.  If you wish to continue using any or all of QUICK COMMAND after
  28.  ;   the trial period, you must become a registered user.  As a registered
  29.  ;   user, you may use QUICK COMMAND on 1 workstation or terminal.
  30.  ;   Additional registrations must be bought for each additional workstation or
  31.  ;   terminal.  To become a registered user, see QC3.DOC
  32.  ;
  33.  ;
  34.  ;   You may send copies of QUICK COMMAND to friends and associates if you abide
  35.  ;   by the following rules:
  36.  ;
  37.  ;   1. It may only be distributed in the original unmodified form.
  38.  ;   2. All original files must be included.
  39.  ;   3. No addition files may be added.
  40.  ;   4. If other files will be on the same disk, QUICK COMMAND files must be in
  41.  ;      a library format such as ".ARC" called "QUICKCMD", or else be put alone
  42.  ;      in a subdirectory called "QUICKCMD".
  43.  ;   5. You may not sell QUICK COMMAND or any part of it.
  44.  ;   6. You are not allowed to charge more then $5 to cover the cost of copying
  45.  ;      and distribution.
  46.  ;   7. You may not distribute any hard copy of the contents of QUICK COMMAND.
  47.  ;
  48.  ;
  49.  ;   These AutoLISP commands and functions are designed to save you time, and
  50.  ;   saving time means saving money.  The registration fee is very modest
  51.  ;   compared to the savings, and much less expensive then typical third party
  52.  ;   AutoCAD software. Be sure to registar if you continue to use them.
  53.  ;
  54.  ;
  55.  ;                                                               DAN
  56.  ;
  57.  ;
  58.  ;
  59.  ;
  60.  ;        AutoCAD and AutoLISP are registered trade marks of Autodesk Inc.
  61.  ;
  62.  ;        ***************************************************************
  63.  ;
  64.  ;   Begin FASTLAYR.LSP
  65.  ;
  66.  
  67. ;  LHP function
  68.  
  69. (defun C:LHP (/ SCA SCB SCC)
  70.    (setvar "cmdecho" 0)
  71.    (setq SCA (car (entsel "Pick an object on the layer to be shown:")))(terpri)
  72.    (if SCA (progn
  73.      (setq SCA (entget SCA))
  74.      (setq SCB (cdr (assoc 8 SCA)))(prompt "Layer name is   ")(prin1 SCB)(terpri)
  75.      (setq SCC (ssget "X" (list (cons 8 SCB))))(prompt "Press ENTER")
  76.      (command "select" SCC pause )
  77.    ))
  78.    (setvar "cmdecho" 1)(princ)
  79. )
  80.  
  81. ;  LHN function
  82.  
  83. (defun C:LHN (/ SCA SCB SCC SCD)
  84.    (setvar "cmdecho" 0)(terpri)
  85.    (prompt "Highlight layer by name.")(terpri)
  86.    (setq SCA (strcase (getstring "Layer name:  "))
  87.          SCB (strlen SCA)
  88.          SCC (tblsearch "layer" SCA))(terpri)
  89.    (if (/= SCB 0)(progn
  90.       (if (/= SCC nil)(progn
  91.          (graphscr)
  92.          (setq SCD (ssget "X" (list (cons 8 SCA))))
  93.          (prompt "Press ENTER")
  94.          (command "SELECT" SCD pause)
  95.          )
  96.          (progn (prompt "Layer ")(princ SCA)(prompt " does not exist."))
  97.       )
  98.    ))(setvar "cmdecho" 1)(princ)
  99. )
  100.  
  101. ;  LFP function
  102.  
  103. (defun C:LFP (/ SCA SCB SCC SCD SCE)(terpri)
  104.    (setvar "cmdecho" 0)
  105.    (prompt "Freeze a layer by pick")(terpri)(prompt " ")(terpri)
  106.    (setq SCE (car (entsel "Pick an entity on the layer to be frozen . . . ")))
  107.    (terpri)
  108.    (if SCE (progn
  109.       (setq SCE (entget SCE)
  110.             SCC (cdr (assoc 8 SCE)))
  111.       (prompt "You picked layer  ")(princ SCC)
  112.       (initget "Yes No")
  113.       (setq SCB (getkword ".  Highlight? Y/N <N>  "))(terpri)
  114.       (if (= SCB "Yes")(progn
  115.          (setq SCD (ssget "X" (list (cons 8 SCC))))
  116.          (command "select" SCD )
  117.       ))
  118.       (prompt "Freeze layer  ")(princ SCC)
  119.       (initget "Yes No")
  120.       (setq SCA (getkword "?  Y/N <Y>  "))
  121.       (if (= SCB "Yes")(command ""))
  122.       (if (/= SCA "No")(command "LAYER" "F" SCC ""))
  123.       )
  124.       (prompt "No entity picked!")
  125.    )(setvar "cmdecho" 1)(princ)
  126. )
  127.  
  128. ;  LMP function
  129.  
  130. (defun C:LMP (/ SCA SCB SCC SCD SCE)(terpri)
  131.    (setvar "cmdecho" 0)
  132.    (prompt "Move entities to a different layer")(terpri)(prompt " ")(terpri)
  133.    (setq SCE (car (entsel "Pick an object on the target layer ")))(terpri)
  134.    (if SCE (progn
  135.       (setq SCE (entget SCE)
  136.             SCC (cdr (assoc 8 SCE)))
  137.       (prompt "You picked layer  ")(princ SCC)
  138.       (initget "Yes No")
  139.       (setq SCB (getkword ".  Highlight? Y/N <N>  "))(terpri)
  140.       (if (= SCB "Yes")(progn
  141.          (setq SCD (ssget "X" (list (cons 8 SCC))))
  142.          (command "select" SCD )
  143.       ))
  144.       (prompt "Select entities to be put on layer ")(prin1 SCC)(terpri)
  145.       (setq SCA (ssget))
  146.       (if (= SCB "Yes")(command ""))
  147.       (if (/= SCA nil)(command "CHANGE" SCA "" "PROP" "LAYER" SCC ""))(terpri)
  148.       (if (and (= SCB "Yes")(/= SCA nil))(progn
  149.          (prompt "New layer  ")(prin1 SCC )(prompt "  is shown.  press ENTER")
  150.          (setq SCD (ssget "X" (list (cons 8 SCC))))
  151.          (command "select" SCD pause )
  152.       ))
  153.    )
  154.    (prompt "No entity picked!")
  155.   )(setvar "cmdecho" 1)(princ)
  156. )
  157.  
  158. ;  LN function
  159.  
  160. (defun C:LN ()
  161.    (setvar "cmdecho" 0)
  162.    (command "layer" "?" "" "")
  163.    (setvar "cmdecho" 1)(princ)
  164. )
  165.  
  166. ;  LSN function
  167.  
  168. (defun C:LSN(/ SCA SCB SCC)
  169.    (setvar "cmdecho" 0)(terpri)
  170.    (prompt "Set current layer by name.")(terpri)
  171.    (setq SCA (strcase (getstring "Layer name:  "))
  172.          SCB (strlen SCA)
  173.          SCC (tblsearch "layer" SCA))(terpri)
  174.    (if (/= SCB 0)(progn
  175.       (if (/= SCC nil)
  176.          (progn (command "LAYER" "Set" SCA "")(graphscr))
  177.          (progn (prompt "Layer ")(princ SCA)(prompt " does not exist."))
  178.       )
  179.    ))(setvar "cmdecho" 1)(princ)
  180. )
  181.  
  182. ;  LTN function
  183.  
  184. (defun C:LTN(/ SCA SCB SCC)
  185.    (setvar "cmdecho" 0)(terpri)
  186.    (prompt "Thaw layer by name.")(terpri)
  187.    (setq SCA (strcase (getstring "Layer name:  "))
  188.          SCB (strlen SCA)
  189.          SCC (tblsearch "layer" SCA))(terpri)
  190.    (if (/= SCB 0)(progn
  191.       (if (/= SCC nil)
  192.          (progn (command "LAYER" "Thaw" SCA "")(graphscr))
  193.          (progn (prompt "Layer ")(princ SCA)(prompt " does not exist."))
  194.       )
  195.    ))(setvar "cmdecho" 1)(princ)
  196. )
  197.  
  198. ;  LFN function
  199.  
  200. (defun C:LFN(/ SCA SCB SCC)
  201.    (setvar "cmdecho" 0)(terpri)
  202.    (prompt "Freeze layer by name.")(terpri)
  203.    (setq SCA (strcase (getstring "Layer name:  "))
  204.          SCB (strlen SCA)
  205.          SCC (tblsearch "layer" SCA))(terpri)
  206.    (if (/= SCB 0)(progn
  207.       (if (/= SCC nil)
  208.          (progn (command "LAYER" "Freeze" SCA "")(graphscr))
  209.          (progn (prompt "Layer ")(princ SCA)(prompt " does not exist."))
  210.       )
  211.    ))(setvar "cmdecho" 1)(princ)
  212. )
  213.  
  214. ;  LTA function
  215.  
  216. (defun C:LTA()(setvar "cmdecho" 0)(command "LAYER" "Thaw" "*" "")
  217.    (setvar "cmdecho" 1)(princ))
  218.  
  219. ;  LFA function
  220.  
  221. (defun C:LFA()(setvar "cmdecho" 0)(command "LAYER" "Freeze" "*" "")
  222.    (setvar "cmdecho" 1)(princ))
  223.  ;
  224.  ;   End FASTLAYR.LSP
  225.